home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / m / mailbox / mystery / applic / app.lst < prev    next >
Encoding:
File List  |  1996-09-18  |  13.1 KB  |  446 lines
  1. ' ****************************************************************************
  2. '
  3. '               Header fuer Mystery-Applikationen unter Gfa-Basic (2.02)
  4. '                          Copyright PARROT-BERLIN
  5. '
  6. '                             Version 13.08.88
  7. '
  8. ' Dieser Header stellt einfache I/O-Routinen für Gfa-Basic , sowie einige
  9. ' Systemvariablen von Mystery-Systems zur Verfügung.
  10. ' Es sind ausschließlich die angebotenen I/O-Routinen zu verwenden, die
  11. ' RS232C-Schnittstelle darf nicht umkonfiguriert werden.
  12. '
  13. ' Die compilierten Programme müssen die Extension .APP haben!!
  14. '
  15. ' Die I/O-Routinen prüfen auf Überschreitung der maximalen Benutzerzeit,
  16. ' Timeout und Carrierverlust. Tritt einer dieser Fälle auf, wird das Pro-
  17. ' gramm automatisch abgebrochen.
  18. '
  19. ' Bei der Ausgabe wird auf CTRL_S, CTRL_X und CTRL_C geprüft. Beim Auftreten
  20. ' von CTRL_S wird die Ausgabe bis zum Empfang eines beliebigen Zeichens
  21. ' (außer CTRL_S) oder bis zum Timeout angehalten. Ein Timeout nach CTRL_S
  22. ' führt nicht zum Abbruch des Programms, die Ausgabe wird nur wieder aufge-
  23. ' nommen. Nach CTRL_X oder CTRL_C wird die Ausgabe abgebrochen, der letzte
  24. ' Kontrollcode wird in Last_ctrl gespeichert. Stringausgaben sind erst wieder
  25. ' möglich, nachdem Last_ctrl vom Programm auf 0 gesetzt wurde.
  26. ' Bei der Stringausgabe kann bestimmt werden, ob nach dem String CRLF gesendet
  27. ' werden soll. Weiterhin kann festgelegt werden, ob die Ausgabe durch CTRL_X
  28. ' oder CTRL_C abbrechbar sein soll.
  29. '
  30. ' Aufbau der Parameterstruktur (C-Style), deren Adresse beim Start der Appli-
  31. ' kation übergeben wird:
  32. '
  33. '
  34. '  typedef struct
  35. '  {
  36. '         FLAG    *APP_FLAG;        /* Pointer auf Systemflags1           */
  37. '         FLAG2   *APP_FLAG2;       /* Pointer auf Systemflags2           */
  38. '         USER    *APP_USER;        /* Pointer auf Userdaten              */
  39. '         char    *APP_SYSPATH;     /* Pfad ins Systemdirectory           */
  40. '         char    *APP_CATBUFF;     /* Pointer auf Catalogbuffer          */
  41. '         long    *APP_CATCOUNT;    /* Länge des Catalogs                 */
  42. '         long    APP_CALLS;        /* aktuelle Zahl der Anrufe           */
  43. '         int     APP_TMAX;         /* maximale Benutzerzeit in min.      */
  44. '         long    APP_LOGINTIME;    /* Einlogzeit in s (24:00=0s)         */
  45. '         int     APP_BAUD;         /* aktuelle Baudrate                  */
  46. '         int     APP_SCREENSIZE;   /* Bildschirmgroesse des Users        */
  47. '         char    *APP_ICNVRT;      /* Pointer auf Inputwandlungstabelle  */
  48. '         char    *APP_OCNVRT;      /* Pointer auf Outputwandlungstabelle */
  49. '  } APP_PAR;
  50. '
  51. ' Sofern die folgenden Funktionen nicht ausreichend sein sollten oder
  52. ' Unklarheiten bestehen, bitte die PARROT unter (030) 724467 anrufen und
  53. ' eine PM an den Syop senden, bzw. eine Nachricht ins Visitors.brd setzen.
  54. '
  55. ' Ich bitte meinen Programmierstil zu entschuldigen, normalerweise program-
  56. ' miere ich in C. sofern dieser Header verbessert wird, den veränderten Hea-
  57. ' der bitte in der PARROT ablegen.
  58. '
  59. '            Vielen Dank und viele Grüße
  60. '
  61. '                     Horst
  62. '
  63. '
  64. '
  65. ' ****************************************************************************
  66. '
  67. '
  68. ' *** für den Programmierer der Applikation interessante Variablen ***
  69. '
  70. Dim Arg$(8)       ! Argumente beim Programmstart
  71. Argc%=0           ! Anzahl der Argumente, Argument 1 (Arg$(0)) ist Appbase
  72. Appbase%=0        ! Zeiger auf Array der Mailboxparameter
  73. Username$=""      ! Name des Users
  74. Syspath$=""       ! Pfad ins Systemdirectory
  75. Catbuffer%=0      ! Adresse des Catalogs
  76. Catcount%=0       ! Länge des Catalogs
  77. Tmax%=0           ! maximale Benutzerzeit in min.
  78. Logintime%=0      ! Einlogzeit in s
  79. Calls%=0          ! Anzahl der Anrufe
  80. Inchar=0          ! Inputzeichen von Mbgetchar
  81. Input$=""         ! Inputstring
  82. Icnvrt%=0         ! Pointer auf Inputkonvertierungstabelle
  83. Ocnvrt%=0         ! Pointer auf Outputkonvertierungstabelle
  84. '
  85. ' *** von Procedures benutzte Variablen oder Definitionen ***
  86. '
  87. Back=0            ! Returnwert für diverse Procedures
  88. Time=0            ! Zwischenspeicher für Zeiten
  89. Tout_time=0       ! Initialtime für Tout
  90. Flag_local!=False ! True, wenn Applikation von der Console gestartet wurde
  91. Flag_tout!=False  ! True bei Timeout
  92. Flag_clost!=False ! True bei Carrierverlust
  93. Flag_exc!=False   ! True bei Überschreitung der maximalen Benutzerzeit
  94. Flag_slow!=False  ! True bewirkt verlangsamte Ausgabe bei 1200 und 2400 Baud
  95. Ibuff_hd%=0       ! Pointer für RS232C
  96. Ibuff_tl%=0       ! Pointer für RS232C
  97. Obuff_hd%=0       ! Pointer für RS232C
  98. Obuff_tl%=0       ! Pointer für RS232C
  99. Last_ctrl=0       ! letzter Kontrollinput
  100. Baud%=0           ! aktuelle Baudrate
  101. Brk=1             ! Definition für Mbstringout
  102. Nbrk=0            ! Definition für Mbstringout
  103. Cr=1              ! Definition für Mbstringout
  104. Ncr=0             ! Definition für Mbstringout
  105. '
  106. Goto Main
  107. '
  108. ' *** vom Programmierer der Applikation zu benutzende I/O-Routinen ***
  109. '
  110. '
  111. Procedure Mbgetchar ! holt Zeichen von RS232C oder Tastatur, bricht
  112.   '                   bei Tout, Carrierverlust oder Tmax-exceeded ab,
  113.   '                   liefert kein Echo. das Zeichen wird in Inchar ab-
  114.   '                   gelegt
  115.   @Ti
  116.   Tout_time=Time
  117.   Inchar=0
  118.   While Inchar=0 And Flag_tout!=False
  119.     @Carrier_lost
  120.     @Maxtime_exceeded
  121.     @Tout
  122.     @Terminal
  123.     @Is_legal
  124.     If Inchar=0
  125.       @Sterminal
  126.       @Is_legal
  127.     Endif
  128.   Wend
  129.   If Flag_tout!=True
  130.     Dpoke Lpeek(Appbase%),Dpeek(Lpeek(Appbase%)) Or &H10 ! Toutflag im System setzen
  131.     Quit
  132.   Endif
  133. Return
  134. '
  135. Procedure Mbstringin(Count)  ! Routine holt Count Zeichen von der Console oder
  136.   '                            oder von RS232C und legt sie in Input$ ab
  137.   Inchar=0
  138.   Input$=""
  139.   While Len(Input$)<Count And Inchar<>13
  140.     @Mbgetchar
  141.     If Inchar=8
  142.       If Len(Input$)>0
  143.         Input$=Left$(Input$,Len(Input$)-1)
  144.         @Backspace
  145.       Endif
  146.       Inchar=0
  147.     Endif
  148.     If Inchar<>13 And Inchar<>0
  149.       Input$=Input$+Chr$(Inchar)
  150.       @Mbputchar(Inchar)
  151.     Endif
  152.   Wend
  153.   @Crlf
  154. Return
  155. '
  156. Procedure Mbstringout(Out$,Nl,Mode)    ! Stringausgabe auf Schirm und RS232C
  157.   ' Nl Cr     -> Ausgabe von CRLF im Anschluss an den String
  158.   ' Nl Ncr    -> nur der String wird ausgegeben
  159.   ' Mode Nbrk -> Ausgabe kann nicht durch CTRL_C oder CTRL_X abgebrochen werden
  160.   ' Mode Brk  -> Ausgabe kann durch CTRL_C oder CTRL_X abgebrochen werden
  161.   Local Counter
  162.   Counter=1
  163.   While (Last_ctrl=0 Or Mode=Nbrk) And Counter<=Len(Out$)
  164.     @Control
  165.     While Dpeek(Obuff_hd%)<>Dpeek(Obuff_tl%) ! warten auf leeren Puffer
  166.     Wend
  167.     @Mbputchar(Asc(Mid$(Out$,Counter,1)))
  168.     Counter=Counter+1
  169.     If Flag_slow!
  170.       Pause 1
  171.     Endif
  172.   Wend
  173.   If Last_ctrl Or Nl
  174.     @Crlf
  175.   Endif
  176. Return
  177. '
  178. ' *** Procedures der Applikation ***
  179. '
  180. Procedure C_to_bas(Source%,Pointer) ! wandelt C-String in Basicstring
  181.   ' Source ist Adresse des C-Strings
  182.   ' Ergebnis wird in Pointer abgelegt
  183.   Local W$
  184.   W$=""
  185.   While Peek(Source%)
  186.     W$=W$+Chr$(Peek(Source%))
  187.     Inc Source%
  188.   Wend
  189.   *Pointer=W$
  190. Return
  191. '
  192. Procedure Getargs ! holt Argumente der Kommandozeile
  193.   Local Count%,Pos%,Work$
  194.   Count%=0
  195.   @C_to_bas(Basepage+129,*Work$)
  196.   If (Len(Work$)=0)
  197.     Quit  ! Fehler, keine Argumente
  198.   Endif
  199.   While (Len(Work$) And Count%<8)
  200.     Pos%=Instr(Work$," ")
  201.     If (Pos%=1)     ! führende Spaces entfernen
  202.       Work$=Mid$(Work$,Pos%+1)
  203.     Else
  204.       If (Pos%>0)   ! Argument übernehmen
  205.         Arg$(Count%)=Left$(Work$,Pos%-1)
  206.         Work$=Mid$(Work$,Pos%+1)
  207.       Else          ! letztes Argument
  208.         Arg$(Count%)=Work$
  209.         Work$=""
  210.       Endif
  211.       Inc Count%
  212.     Endif
  213.   Wend
  214.   Argc%=Count%
  215.   Appbase%=Val(Arg$(0))
  216. Return
  217. '
  218. Procedure Get_uname  ! holt Namen des Users
  219.   @C_to_bas(Lpeek(Appbase%+8),*Username$)
  220. Return
  221. '
  222. Procedure Get_syspath ! holt Systempfad
  223.   @C_to_bas(Lpeek(Appbase%+12),*Syspath$)
  224. Return
  225. '
  226. Procedure Init ! holt Systemvariablen
  227.   Local Iorec%,Dummy
  228.   Dummy=Xbios(21,W:1)      ! der Sysop moechte gerne einen blinkenden Cursor...
  229.   Dummy=Xbios(21,W:2)
  230.   Iorec%=Xbios(14,W:0)
  231.   Ibuff_tl%=Iorec%+6       ! saemtliche Dokumentationen sind falsch!!
  232.   Ibuff_hd%=Iorec%+8       ! DANKE ANSON...
  233.   Obuff_tl%=Iorec%+20
  234.   Obuff_hd%=Iorec%+22
  235.   @Getargs
  236.   @Get_uname
  237.   @Get_syspath
  238.   Catbuffer%=Lpeek(Appbase%+16)
  239.   Catcount%=Lpeek(Lpeek(Appbase%+20))
  240.   Calls%=Lpeek(Appbase%+24)
  241.   Tmax%=Dpeek(Appbase%+28)
  242.   Logintime%=Lpeek(Appbase%+30)
  243.   Baud%=Dpeek(Appbase%+34)
  244.   Flag_local!=(Dpeek(Lpeek(Appbase%)) And &H80)
  245.   Icnvrt%=Lpeek(Appbase%+38)
  246.   Ocnvrt%=Lpeek(Appbase%+42)
  247. Return
  248. '
  249. Procedure Carrier  ! prüft, ob Carrier anliegt
  250.   Back=(Not Peek(&HFFFA01)) And &H2
  251. Return
  252. '
  253. Procedure Carrier_lost ! prüft, ob Carrier verloren ging
  254.   @Carrier
  255.   Flag_clost!=(Back=0 And Flag_local!=0)
  256.   If Flag_clost!=True   ! Programm wird bei Carrierverlust beendet
  257.     Quit
  258.   Endif
  259. Return
  260. '
  261. Procedure Ti     ! Systemzeit in s
  262.   Time=Val(Left$(Time$,2))*3600+Val(Mid$(Time$,4,2))*60+Val(Right$(Time$,2))
  263. Return
  264. '
  265. Procedure Tout  ! setzt Flag_tout! bei Timeout auf true
  266.   Local X
  267.   @Ti
  268.   X=Time-Tout_time
  269.   If X<0
  270.     X=X+86400
  271.   Endif
  272.   If X>60
  273.     Flag_tout!=True
  274.   Endif
  275. Return
  276. '
  277. Procedure Maxtime_exceeded ! setzt Flag_exc! bei Überschreitung der maximalen
  278.   '                          Benutzerzeit auf true und beendet Applikation
  279.   Local Zeit
  280.   @Ti
  281.   Zeit=Time-Logintime%
  282.   If Zeit<0
  283.     Zeit=Zeit+86400
  284.   Endif
  285.   If Zeit>Tmax%*60
  286.     Flag_exc!=True
  287.     Quit
  288.   Endif
  289. Return
  290. '
  291. Procedure Is_legal ! prüft, ob Inchar ein legales Zeichen darstellt
  292.   Local X
  293.   If Inchar=27
  294.     Inchar=0
  295.   Endif
  296.   Inchar=Peek(Icnvrt%+Inchar)
  297. Return
  298. '
  299. Procedure Empty_rsbuf   ! löscht RS232C-Inputbuffer
  300.   Dpoke Ibuff_hd%,0
  301.   Dpoke Ibuff_tl%,0
  302. Return
  303. '
  304. Procedure Sterminal    ! holt Zeichen von RS232C
  305.   Local X
  306.   X=Bios(1,W:1)        ! bconstat(aux)
  307.   @Carrier
  308.   If Back And X
  309.     Inchar=Bios(2,W:1) ! bconin(aux)
  310.   Else
  311.     Inchar=0
  312.   Endif
  313. Return
  314. '
  315. Procedure Terminal    ! holt Zeichen von der Console
  316.   Local X
  317.   X=Bios(1,W:2)        ! bconstat(con)
  318.   If X
  319.     Inchar=Bios(2,W:2) ! bconin(con)
  320.     Inchar=Inchar And &HFF
  321.   Else
  322.     Inchar=0
  323.   Endif
  324. Return
  325. '
  326. Procedure Mbputchar(Char)        ! Einzelzeichenausgabe auf Schirm und RS232C
  327.   Local Dummy,Auxout1,Auxout2,Conout1
  328.   If (Flag_local!=True)
  329.     Conout1=Peek(Ocnvrt%+2*Char)
  330.   Else
  331.     Auxout1=Peek(Ocnvrt%+2*Char)
  332.     Auxout2=Peek(Ocnvrt%+2*Char+1)
  333.     Conout1=Char
  334.   Endif
  335.   @Carrier_lost
  336.   @Maxtime_exceeded
  337.   Dummy=Bios(3,W:2,W:Conout1)       ! Bconout(CON,c)
  338.   @Carrier
  339.   If Back<>0
  340.     Dummy=Bios(3,W:1,W:Auxout1)     ! Bconout(AUX,c);
  341.   Endif
  342.   @Carrier
  343.   If Back<>0
  344.     Dummy=Bios(3,W:1,W:Auxout2)
  345.   Endif
  346. Return
  347. '
  348. Procedure Control ! fragt Eingabekanäle auf CTRL ab
  349.   Local Store
  350.   Store=Inchar
  351.   @Terminal
  352.   If Inchar=0
  353.     @Sterminal
  354.   Endif
  355.   If Inchar<>0
  356.     If Inchar=19    ! Input ist CTRL_S
  357.       @Halt
  358.     Endif
  359.     @Empty_rsbuf
  360.     If Inchar=3 Or Inchar=24
  361.       Last_ctrl=Inchar
  362.     Else
  363.       Last_ctrl=0
  364.     Endif
  365.     Inchar=Store
  366.   Endif
  367. Return
  368. '
  369. Procedure Halt ! wartet auf auf nächste Eingabe des Users nach CTRL_S
  370.   @Ti
  371.   Tout_time=Time
  372.   Repeat
  373.     @Terminal
  374.     If Inchar=0
  375.       @Sterminal
  376.     Endif
  377.     If Inchar=19
  378.       Inchar=0
  379.     Endif
  380.     @Carrier_lost
  381.     @Tout
  382.   Until Inchar<>0 Or Flag_tout!=True
  383.   Flag_tout!=False
  384. Return
  385. '
  386. Procedure Crlf        ! gibt CR und LF aus
  387.   @Mbputchar(13)
  388.   @Mbputchar(10)
  389. Return
  390. '
  391. Procedure Backspace   ! letztes Zeichen löschen
  392.   @Mbputchar(8)
  393.   @Mbputchar(32)
  394.   @Mbputchar(8)
  395. Return
  396. '
  397. ' ******** Start des Hauptprogramms mit einigen Beispielen ********
  398. '
  399. Main:
  400. @Init                               ! Init muß auf jeden Fall aufgerufen werden !
  401. If Baud%>300 Or Flag_local!=True    ! Wenn gewünscht, kann die Ausgabe gebremst werden.
  402.   Flag_slow!=True
  403. Endif
  404. ' Ausgaben lassen sich nicht abbrechen, Last_ctrl braucht nicht auf 0 gesetzt
  405. ' zu werden
  406. @Crlf            ! Leerzeilen nach Programmstart
  407. @Crlf
  408. @Mbstringout("         TESTAPPLIKATION",Cr,Nbrk)
  409. @Mbstringout("         ===============",Cr,Nbrk)
  410. @Crlf
  411. @Crlf
  412. ' Ausgabe ohne CRLF
  413. @Mbstringout("Moechtest Du eine Anleitung (J/N)?",Ncr,Nbrk)
  414. ' Antwort des Users holen
  415. @Mbgetchar
  416. ' Antwort echoen und CRLF senden
  417. @Mbputchar(Inchar)
  418. @Crlf
  419. @Crlf
  420. ' Antwort auswerten
  421. If Chr$(Inchar)="J" Or Chr$(Inchar)="j"
  422.   Last_ctrl=0    ! die folgenden Ausgaben können abgebrochen werden, daher muß
  423.   '                  Last_ctrl auf 0 gesetzt werden
  424.   @Mbstringout("Das ist ein Beispiel für eine Gebrauchsanweisung, die natuerlich",Cr,Brk)
  425.   @Mbstringout("hier nur einen totalen Unsinnstext bringt. Es wird aber gezeigt",Cr,Brk)
  426.   @Mbstringout("dass hier ein Text ausgegeben wird, der sich abbrechen laesst.",Cr,Brk)
  427. Endif
  428. While Input$<>"ENDE"
  429.   @Crlf
  430.   O$="Was nun "+Username$+" (Spiel,Ende)?>"
  431.   @Mbstringout(O$,Ncr,Nbrk)
  432.   ' Antwort holen
  433.   @Mbstringin(20)
  434.   Input$=Upper$(Input$)
  435.   @Crlf
  436.   ' Antwort auswerten
  437.   If Input$="SPIEL"
  438.     @Mbstringout("Das waere das Spiel....",Cr,Nbrk)
  439.   Else
  440.     If Input$<>"ENDE"
  441.       @Mbstringout("Eingabefehler!!!",Cr,Nbrk)
  442.     Endif
  443.   Endif
  444. Wend
  445. Quit
  446.